functor DeSsa (S : DESSA_STRUCTS) : DESSA =
struct
  open S
  
  
  structure Cfg = Cfg
  
  local open Cfg
  in structure Id = Id
     structure Intl = Intl
     structure T = Types
     structure B = Binop
     structure O = Operand
     structure K = Block
     structure S = Structs
     structure J = Transfer
     structure M = Stm
     structure F = Function
     structure P = Program
  end
  
  val tag = !Control.doShowOptVerbose
  fun debugPrint s =
      if tag
      then print s
      else ()
     
  val {get = assignList, set = setAssignList, destroy = destroyAssignList, ...} :
      {get : Id.t -> M.t list, set : Id.t * M.t list -> unit, destroy : unit -> unit}=
      Property.destGetSet (Id.plist, Property.initConst [])
  
  fun annotateBlock b =
      case b
       of K.T {name,
               prop,
               stms,
               transfer,
               successors} =>
          let val phis = K.getAllPhi b
              fun doit l =
                  case l
                   of [] => ()
                    | M.Phi {line, dest, src} :: xs =>
                      let val _ = debugPrint (String.concat ["locate a phi function: ", Counter.toString line])
                          fun loop m =
                              case m
                               of [] => ()
                                | {operand, from} :: ys =>
                                  let val insert = M.Assign {line = Counter.next (),
                                                             dest = dest,
                                                             src = operand,
                                                             ty = T.Intt}
                                      val old = assignList from
                                      val _ = setAssignList (from, insert :: old)
                                  in  loop ys
                                  end
                          val _ = loop src
                      in  doit xs
                      end
                    | _ :: xs => raise Fail "compiler bug"
              val _ = doit phis
          in  K.T {name = name,
                   prop = prop,
                   stms = List.filter (not o M.isPhi) stms,
                   transfer = transfer,
                   successors = successors}
          end
          
  fun annotateBlocks bs = List.map annotateBlock bs
      
  fun shrinkBlock b =
      let val insert = assignList (K.name b)
          val b = K.addStmsEnd (b, insert)
      in  b
      end
           
  fun shrinkBlocks bs = List.map shrinkBlock bs  
      
  fun shrinkFunc f =
      case f
       of F.T {name,
               exit,
               rettype,
               args,
               locals,
               blocks,
               pre,
               post} =>
          let val blocks = annotateBlocks blocks
              val blocks = shrinkBlocks blocks
              val new = F.T {name = name,
                             exit = exit,
                             rettype = rettype,
                             args = args,
                             locals = locals,
                             blocks = blocks,
                             pre = pre,
                             post = post}
              val _ = destroyAssignList ()
              val _ = debugPrint "\noutput the graph after deSsa\n"
              val _ = if tag
                      then F.toDot (new, "afterDeSsa")
                      else ()
          in  new
          end
  
  fun shrinkProg f =
      case f
       of P.T {structs, gvars, funcs, ...} =>
          let val _ = ()
          in  P.T {structs = structs,
                   gvars = gvars,
                   funcs = List.map shrinkFunc funcs}
          end
  
  fun trans f =
      let val _ = debugPrint "\neliminate phi functions starting\n"
          val _ = if tag
                  then File.output ("beforeDeSsa.c", P.toString f)
                  else ()
          val new = shrinkProg f
          val _ = if tag
                  then File.output ("afterDeSsa.c", P.toString new)
                  else ()
          val _ = debugPrint "\neliminate phi functions finished\n"
      in  new
      end
end
